1 - Información sobre los datos

Un banco quiere disponer de un modelo de credit scoring para lo cual dispone de un conjunto de datos con 1.646 registros de clientes a los que concedió un crédito. Esta base de datos contiene siete variables numéricas y cuatro categóricas. La variable denominada CLASE muestra la información de si el cliente devolvió el crédito o no y toma dos valores: SI y NO.

La descripción de la base de datos es la siguiente:

TIPO_VIVIENDA: Propiedad libre, Propiedad hipotecada, Alquiler, Vive con la familia y Otros.

VALOR_VIVIENDA: Valor de la vivienda.

PATRIMONIO: Montante del patrimonio.

NACIONALIDAD: Español y Extranjero.

IMPORTE: Importe del préstamo.

CUOTA: Cuota que paga al banco por el préstamo concedido.

INGRESOS: Ingresos del peticionario del crédito.

SALDO: Saldo que mantiene en la cuenta bancaria.

EDAD: Edad.

ESTADO_CIVIL: Esta variable toma tres valores: Casado, Separado y Soltero.

CLASE: Muestra dos valores, No para los que no pagaron el crédito y SI para los clientes que sí cumplieron con el pago del crédito.

2 - Librerías y base de datos

Instalamos los paquetes que necesitaremos durante nuestro análisis.

rm(list = ls())

suppressWarnings(suppressPackageStartupMessages({
  
  library(skimr)
  library(funModeling)
  library(inspectdf) 
  library(DataExplorer) 
  library(PerformanceAnalytics) 
  library(corrplot) 
  library(flextable)
  library(kableExtra)
  library(officer)
  library(rmarkdown)
  library(magrittr)
  library(tidyverse) 
  library(patchwork)  
  library(ggthemes)
  library(ggpubr) 
  library(data.table) 
  library(fastDummies)
  library(naniar)
  library(mice)
  library(VIM)
  library(gmodels) 
  library(dlookr) 
  library(randomForest) 
  library(dlookr)
  library(sampling) 
  library(DMwR)
  library(car)
}))

Lectura de la base de datos and convirtiéndolo en un data.table.

datos = read.csv("datos_credit_scoring.csv")
datos = as.data.table(datos)

3 - Análisis descriptivo

Descripción de la base de datos

Vemos la estructura de nuestra base de datos:

str(datos)
## Classes 'data.table' and 'data.frame':   1646 obs. of  11 variables:
##  $ TIPO_VIVIENDA : chr  "Propiedad hipotecada" "Alquiler" "Alquiler" "Propiedad hipotecada" ...
##  $ VALOR_VIVIENDA: int  150000 0 0 150000 39000 0 16994 170000 36000 150000 ...
##  $ PATRIMONIO    : int  0 0 0 0 0 0 72575 0 30000 0 ...
##  $ NACIONALIDAD  : chr  "Español" "Español" "Extranjero" "Español" ...
##  $ IMPORTE       : int  9000 2000 11000 12000 6000 10000 4800 16500 20000 15000 ...
##  $ CUOTA         : int  174 62 213 202 117 193 94 270 317 290 ...
##  $ INGRESOS      : int  18992 25500 14184 8000 NA 11200 31431 19069 12489 NA ...
##  $ SALDO         : int  820 0 32369 97 558 17902 2339 1075 875 448 ...
##  $ EDAD          : int  42 51 46 30 36 30 36 50 40 33 ...
##  $ ESTADO_CIVIL  : chr  "Soltero" "Soltero" "Casado" "Casado" ...
##  $ CLASE         : chr  "SI" "NO" "SI" "SI" ...
##  - attr(*, ".internal.selfref")=<externalptr>

Buscamos entradas duplicadas y vemos que no hay ninguna.

anyDuplicated(datos)
## [1] 0

Convertimos las variables de tipo carácter a factores.

datos$TIPO_VIVIENDA = as.factor(datos$TIPO_VIVIENDA)
datos$NACIONALIDAD = as.factor(datos$NACIONALIDAD)
datos$ ESTADO_CIVIL = as.factor(datos$ ESTADO_CIVIL)
datos$CLASE = as.factor(datos$CLASE)

Vemos las primeras filas:

head(datos)
##           TIPO_VIVIENDA VALOR_VIVIENDA PATRIMONIO NACIONALIDAD IMPORTE CUOTA
## 1: Propiedad hipotecada         150000          0      Español    9000   174
## 2:             Alquiler              0          0      Español    2000    62
## 3:             Alquiler              0          0   Extranjero   11000   213
## 4: Propiedad hipotecada         150000          0      Español   12000   202
## 5: Propiedad hipotecada          39000          0      Español    6000   117
## 6:  Vive con la familia              0          0      Español   10000   193
##    INGRESOS SALDO EDAD ESTADO_CIVIL CLASE
## 1:    18992   820   42      Soltero    SI
## 2:    25500     0   51      Soltero    NO
## 3:    14184 32369   46       Casado    SI
## 4:     8000    97   30       Casado    SI
## 5:       NA   558   36       Casado    SI
## 6:    11200 17902   30      Soltero    SI
str(datos)
## Classes 'data.table' and 'data.frame':   1646 obs. of  11 variables:
##  $ TIPO_VIVIENDA : Factor w/ 5 levels "Alquiler","Otros",..: 3 1 1 3 3 5 3 3 4 3 ...
##  $ VALOR_VIVIENDA: int  150000 0 0 150000 39000 0 16994 170000 36000 150000 ...
##  $ PATRIMONIO    : int  0 0 0 0 0 0 72575 0 30000 0 ...
##  $ NACIONALIDAD  : Factor w/ 2 levels "Español","Extranjero": 1 1 2 1 1 1 1 1 1 1 ...
##  $ IMPORTE       : int  9000 2000 11000 12000 6000 10000 4800 16500 20000 15000 ...
##  $ CUOTA         : int  174 62 213 202 117 193 94 270 317 290 ...
##  $ INGRESOS      : int  18992 25500 14184 8000 NA 11200 31431 19069 12489 NA ...
##  $ SALDO         : int  820 0 32369 97 558 17902 2339 1075 875 448 ...
##  $ EDAD          : int  42 51 46 30 36 30 36 50 40 33 ...
##  $ ESTADO_CIVIL  : Factor w/ 3 levels "Casado","Separado",..: 3 3 1 1 1 3 1 1 1 1 ...
##  $ CLASE         : Factor w/ 2 levels "NO","SI": 2 1 2 2 2 2 2 2 2 2 ...
##  - attr(*, ".internal.selfref")=<externalptr>

Resumen estadístico

Comenzamos con el comando summary(), que nos da las magnitudes básicas de cada variable.

summary(datos)
##               TIPO_VIVIENDA VALOR_VIVIENDA      PATRIMONIO    
##  Alquiler            :200   Min.   :      0   Min.   :     0  
##  Otros               : 77   1st Qu.:      0   1st Qu.:     0  
##  Propiedad hipotecada:590   Median :  75000   Median :     0  
##  Propiedad libre     :463   Mean   :  94553   Mean   :  9731  
##  Vive con la familia :316   3rd Qu.: 150000   3rd Qu.:     0  
##                             Max.   :1280000   Max.   :629214  
##                                                               
##      NACIONALIDAD     IMPORTE          CUOTA           INGRESOS     
##  Español   :1409   Min.   :  285   Min.   :  11.0   Min.   :     0  
##  Extranjero: 237   1st Qu.: 4000   1st Qu.: 101.0   1st Qu.: 12600  
##                    Median : 9000   Median : 193.0   Median : 16514  
##                    Mean   : 8655   Mean   : 197.2   Mean   : 19048  
##                    3rd Qu.:11475   3rd Qu.: 250.0   3rd Qu.: 23443  
##                    Max.   :70000   Max.   :2114.0   Max.   :105978  
##                                                     NA's   :84      
##      SALDO               EDAD         ESTADO_CIVIL CLASE    
##  Min.   :  -920.0   Min.   :20.00   Casado  :852   NO: 164  
##  1st Qu.:    73.2   1st Qu.:34.00   Separado: 91   SI:1482  
##  Median :   845.0   Median :44.00   Soltero :703            
##  Mean   :  4676.8   Mean   :43.95                           
##  3rd Qu.:  3826.0   3rd Qu.:53.00                           
##  Max.   :339116.0   Max.   :90.00                           
##                     NA's   :62

Utilizamos el comando skim(), obtenemos más información útil, como el número de valores que faltan, los valores únicos en el caso de las variables cualitativas, los valores medios y la desviación típica en el caso de las variables numéricas.

skim(datos)
Data summary
Name datos
Number of rows 1646
Number of columns 11
Key NULL
_______________________
Column type frequency:
factor 4
numeric 7
________________________
Group variables None

Variable type: factor

skim_variable n_missing complete_rate ordered n_unique top_counts
TIPO_VIVIENDA 0 1 FALSE 5 Pro: 590, Pro: 463, Viv: 316, Alq: 200
NACIONALIDAD 0 1 FALSE 2 Esp: 1409, Ext: 237
ESTADO_CIVIL 0 1 FALSE 3 Cas: 852, Sol: 703, Sep: 91
CLASE 0 1 FALSE 2 SI: 1482, NO: 164

Variable type: numeric

skim_variable n_missing complete_rate mean sd p0 p25 p50 p75 p100 hist
VALOR_VIVIENDA 0 1.00 94552.79 108894.54 0 0.00 75000.0 150000 1280000 ▇▁▁▁▁
PATRIMONIO 0 1.00 9730.86 40940.13 0 0.00 0.0 0 629214 ▇▁▁▁▁
IMPORTE 0 1.00 8654.51 6661.21 285 4000.00 9000.0 11475 70000 ▇▂▁▁▁
CUOTA 0 1.00 197.18 126.82 11 101.00 193.0 250 2114 ▇▁▁▁▁
INGRESOS 84 0.95 19047.69 11325.72 0 12600.00 16513.5 23443 105978 ▇▃▁▁▁
SALDO 0 1.00 4676.85 14228.30 -920 73.25 845.0 3826 339116 ▇▁▁▁▁
EDAD 62 0.96 43.95 12.27 20 34.00 44.0 53 90 ▆▇▆▁▁

La función skim() nos ha mostrado que faltan algunos valores en nuestro conjunto de datos. Veámoslos con algunos métodos más.

colSums(is.na(datos))
##  TIPO_VIVIENDA VALOR_VIVIENDA     PATRIMONIO   NACIONALIDAD        IMPORTE 
##              0              0              0              0              0 
##          CUOTA       INGRESOS          SALDO           EDAD   ESTADO_CIVIL 
##              0             84              0             62              0 
##          CLASE 
##              0
sapply(datos, function(x) sum(is.na(x)))
##  TIPO_VIVIENDA VALOR_VIVIENDA     PATRIMONIO   NACIONALIDAD        IMPORTE 
##              0              0              0              0              0 
##          CUOTA       INGRESOS          SALDO           EDAD   ESTADO_CIVIL 
##              0             84              0             62              0 
##          CLASE 
##              0
sum(is.na(datos))
## [1] 146

Hemos visto algunos detalles estadísticos utilizando summary() y skim(). Ahora usando la librería funmodeling, usaremos algunas funciones más para obtener detalles similares.

status(datos)
##                      variable q_zeros     p_zeros q_na       p_na q_inf p_inf
## TIPO_VIVIENDA   TIPO_VIVIENDA       0 0.000000000    0 0.00000000     0     0
## VALOR_VIVIENDA VALOR_VIVIENDA     568 0.345078979    0 0.00000000     0     0
## PATRIMONIO         PATRIMONIO    1365 0.829283111    0 0.00000000     0     0
## NACIONALIDAD     NACIONALIDAD       0 0.000000000    0 0.00000000     0     0
## IMPORTE               IMPORTE       0 0.000000000    0 0.00000000     0     0
## CUOTA                   CUOTA       0 0.000000000    0 0.00000000     0     0
## INGRESOS             INGRESOS      12 0.007290401   84 0.05103281     0     0
## SALDO                   SALDO     286 0.173754557    0 0.00000000     0     0
## EDAD                     EDAD       0 0.000000000   62 0.03766707     0     0
## ESTADO_CIVIL     ESTADO_CIVIL       0 0.000000000    0 0.00000000     0     0
## CLASE                   CLASE       0 0.000000000    0 0.00000000     0     0
##                   type unique
## TIPO_VIVIENDA   factor      5
## VALOR_VIVIENDA integer    352
## PATRIMONIO     integer    102
## NACIONALIDAD    factor      2
## IMPORTE        integer    303
## CUOTA          integer    405
## INGRESOS       integer   1271
## SALDO          integer   1189
## EDAD           integer     62
## ESTADO_CIVIL    factor      3
## CLASE           factor      2

Utilizando el comando profiling_num(), obtenemos las estadísticas anteriores, pero además de eso obtenemos algunos detalles más, como el rango,inter-quartile range,skewness y kurtosis.

profiling_num(datos)
##         variable        mean      std_dev variation_coef    p_01    p_05
## 1 VALOR_VIVIENDA 94552.78554 108894.53907      1.1516799    0.00    0.00
## 2     PATRIMONIO  9730.86270  40940.12904      4.2072456    0.00    0.00
## 3        IMPORTE  8654.50729   6661.21080      0.7696811  610.35  825.50
## 4          CUOTA   197.17558    126.82067      0.6431865   18.00   29.25
## 5       INGRESOS 19047.68758  11325.71673      0.5945980  127.47 5076.05
## 6          SALDO  4676.84872  14228.30237      3.0422841 -123.65    0.00
## 7           EDAD    43.94823     12.27089      0.2792123   21.00   25.00
##       p_25    p_50   p_75      p_95      p_99  skewness   kurtosis       iqr
## 1     0.00 75000.0 150000 294500.00 420389.40  2.351692  16.837267 150000.00
## 2     0.00     0.0      0  52500.00 200000.00  7.510370  76.539677      0.00
## 3  4000.00  9000.0  11475  21000.00  30000.00  1.656710   9.278657   7475.00
## 4   101.00   193.0    250    401.00    568.40  2.715092  34.838294    149.00
## 5 12600.00 16513.5  23443  39995.00  59652.99  1.947351  10.047700  10843.00
## 6    73.25   845.0   3826  19850.25  57590.90 11.142248 207.996333   3752.75
## 7    34.00    44.0     53     64.00     73.00  0.262961   2.506213     19.00
##             range_98          range_80
## 1      [0, 420389.4]       [0, 240000]
## 2         [0, 2e+05]        [0, 18000]
## 3    [610.35, 30000]   [1161.5, 18000]
## 4        [18, 568.4]         [44, 341]
## 5 [127.47, 59652.99] [8005.7, 32129.3]
## 6 [-123.65, 57590.9]        [0, 11330]
## 7           [21, 73]          [29, 60]

La función plot_num() nos permite visualizar histogramas de variables numéricas.

plot_num(datos)
## Warning: The `<scale>` argument of `guides()` cannot be `FALSE`. Use "none" instead as
## of ggplot2 3.3.4.
## ℹ The deprecated feature was likely used in the funModeling package.
##   Please report the issue at <https://github.com/pablo14/funModeling/issues>.

Visualización de variables categóricas por frecuencia:

freq(datos)

##          TIPO_VIVIENDA frequency percentage cumulative_perc
## 1 Propiedad hipotecada       590      35.84           35.84
## 2      Propiedad libre       463      28.13           63.97
## 3  Vive con la familia       316      19.20           83.17
## 4             Alquiler       200      12.15           95.32
## 5                Otros        77       4.68          100.00

##   NACIONALIDAD frequency percentage cumulative_perc
## 1      Español      1409       85.6            85.6
## 2   Extranjero       237       14.4           100.0

##   ESTADO_CIVIL frequency percentage cumulative_perc
## 1       Casado       852      51.76           51.76
## 2      Soltero       703      42.71           94.47
## 3     Separado        91       5.53          100.00

##   CLASE frequency percentage cumulative_perc
## 1    SI      1482      90.04           90.04
## 2    NO       164       9.96          100.00
## [1] "Variables processed: TIPO_VIVIENDA, NACIONALIDAD, ESTADO_CIVIL, CLASE"

Aquí vemos gráficos de caja de diferentes variables.

plotar(datos, target= "CLASE", plot_type="boxplot")
## Warning: The `fun.y` argument of `stat_summary()` is deprecated as of ggplot2 3.3.0.
## ℹ Please use the `fun` argument instead.
## ℹ The deprecated feature was likely used in the funModeling package.
##   Please report the issue at <https://github.com/pablo14/funModeling/issues>.

## Warning: Removed 84 rows containing non-finite values (`stat_boxplot()`).
## Warning: Removed 84 rows containing non-finite values (`stat_summary()`).

## Warning: Removed 62 rows containing non-finite values (`stat_boxplot()`).
## Warning: Removed 62 rows containing non-finite values (`stat_summary()`).

Hemos visto los tipos de variables y hemos comprobado si hay filas duplicadas y, si hay NAs en nuestro conjunto de datos.Hemos visto los valores únicos en cada columna, la media y el rango en el caso de variables numéricas.También, hemos visto las ocurrencias de cada factor en la tabla de frecuencias y finalmente, hemos visto los gráficos de caja de cada variable por su CLASE.

Ahora veremos algunos estadísticos de variables categóricas y cómo se comportan con la variable de clase CLASE.

categoricas <- datos %>% select (TIPO_VIVIENDA,NACIONALIDAD,ESTADO_CIVIL,CLASE)

categ_analysis(categoricas, target = 'CLASE')
## Warning: `summarise_()` was deprecated in dplyr 0.7.0.
## ℹ Please use `summarise()` instead.
## ℹ The deprecated feature was likely used in the funModeling package.
##   Please report the issue at <https://github.com/pablo14/funModeling/issues>.
## Warning: `group_by_()` was deprecated in dplyr 0.7.0.
## ℹ Please use `group_by()` instead.
## ℹ See vignette('programming') for more help
## ℹ The deprecated feature was likely used in the funModeling package.
##   Please report the issue at <https://github.com/pablo14/funModeling/issues>.
##          TIPO_VIVIENDA mean_target sum_target perc_target q_rows perc_rows
## 1             Alquiler       0.360         72       0.439    200     0.122
## 2                Otros       0.208         16       0.098     77     0.047
## 3  Vive con la familia       0.133         42       0.256    316     0.192
## 4 Propiedad hipotecada       0.047         28       0.171    590     0.358
## 5      Propiedad libre       0.013          6       0.037    463     0.281
## 
##   NACIONALIDAD mean_target sum_target perc_target q_rows perc_rows
## 1   Extranjero       0.384         91       0.555    237     0.144
## 2      Español       0.052         73       0.445   1409     0.856
## 
##   ESTADO_CIVIL mean_target sum_target perc_target q_rows perc_rows
## 1     Separado       0.165         15       0.091     91     0.055
## 2      Soltero       0.159        112       0.683    703     0.427
## 3       Casado       0.043         37       0.226    852     0.518
## [1] "Variables processed: TIPO_VIVIENDA, NACIONALIDAD, ESTADO_CIVIL"
cross_plot(categoricas, target = 'CLASE', auto_binning = TRUE )

4 - Análisis de correlaciones

Ahora vamos a ver cómo se comportan las variables entre sí y con nuestra variable objetivo “CLASE”. También intentaremos averiguar qué variables explican la variable CLASE mucho mejor que otras.

Tablas de correspondencias y gráficos

#creamos un conjunto de datos con sólo variables numéricas y sin NAs.
datos_num = subset(na.omit(datos), select = c("VALOR_VIVIENDA","PATRIMONIO","IMPORTE","CUOTA","INGRESOS","SALDO","EDAD"))

Creación de una matriz de correlaciones:

corr_datos_num = as.data.frame((cor(datos_num)))
round(corr_datos_num,2)
##                VALOR_VIVIENDA PATRIMONIO IMPORTE CUOTA INGRESOS SALDO EDAD
## VALOR_VIVIENDA           1.00       0.18    0.11  0.12     0.32  0.12 0.37
## PATRIMONIO               0.18       1.00    0.11  0.11     0.07  0.03 0.16
## IMPORTE                  0.11       0.11    1.00  0.91     0.10  0.02 0.06
## CUOTA                    0.12       0.11    0.91  1.00     0.14  0.04 0.10
## INGRESOS                 0.32       0.07    0.10  0.14     1.00  0.22 0.18
## SALDO                    0.12       0.03    0.02  0.04     0.22  1.00 0.12
## EDAD                     0.37       0.16    0.06  0.10     0.18  0.12 1.00

Mejores formas de visualizar las correlaciones:

correlaciones <- round(cor(datos_num), 1)
corrplot(correlaciones, method="number", type="upper")

chart.Correlation(datos_num, histogram = F, pch=19)
## Warning in par(usr): argument 1 does not name a graphical parameter

## Warning in par(usr): argument 1 does not name a graphical parameter

## Warning in par(usr): argument 1 does not name a graphical parameter

## Warning in par(usr): argument 1 does not name a graphical parameter

## Warning in par(usr): argument 1 does not name a graphical parameter

## Warning in par(usr): argument 1 does not name a graphical parameter

## Warning in par(usr): argument 1 does not name a graphical parameter

## Warning in par(usr): argument 1 does not name a graphical parameter

## Warning in par(usr): argument 1 does not name a graphical parameter

## Warning in par(usr): argument 1 does not name a graphical parameter

## Warning in par(usr): argument 1 does not name a graphical parameter

## Warning in par(usr): argument 1 does not name a graphical parameter

## Warning in par(usr): argument 1 does not name a graphical parameter

## Warning in par(usr): argument 1 does not name a graphical parameter

## Warning in par(usr): argument 1 does not name a graphical parameter

## Warning in par(usr): argument 1 does not name a graphical parameter

## Warning in par(usr): argument 1 does not name a graphical parameter

## Warning in par(usr): argument 1 does not name a graphical parameter

## Warning in par(usr): argument 1 does not name a graphical parameter

## Warning in par(usr): argument 1 does not name a graphical parameter

## Warning in par(usr): argument 1 does not name a graphical parameter

Los valores de la tabla representan el grado de correlación entre pares de variables. Los valores van de -1 a 1, donde -1 representa una correlación negativa perfecta, 0 representa ninguna correlación y 1 representa una correlación positiva perfecta. Esta tabla nos da la correlación entre cada par de variables, con el tamaño de letra en función del grado de correlación, así como un conjunto de 0 a 3 estrellas, que indica la importancia de la correlación, de menor a mayor.

Observando la tabla, podemos ver que IMPORTE y CUOTA están fuertemente correlacionados positivamente, con un coeficiente de correlación de 0,91. El coeficiente de correlación entre “VALOR_VIVIENDA” y “EDAD” es de 0,37, lo que indica una correlación positiva entre estas dos variables, al igual que la correlación de 0,32 entre “VALOR_VIVIENDA” e “INGRESOS”. Ninguna de las variables tiene una correlación negativa entre sí y la mayoría de ellas tienen una correlación positiva y significativa.

Otra forma de ver las correlaciones es utilizando la función plot_correlation. Cuanto más oscuro sea el color, más correlacionadas estarán las variables.

plot_correlation(datos_num)

Calculamos el nivel de significación de las diferentes correlaciones (p-value):

correlacion_pvalue = cor.mtest(datos_num, conf.level=0.95)$p

rownames(correlacion_pvalue) = rownames(correlacion_pvalue)
colnames(correlacion_pvalue) = colnames(correlacion_pvalue)

La matriz resultante muestra los valores p de las correlaciones entre las variables numéricas. Los valores de la diagonal son todos 0, ya que la correlación entre una variable consigo misma es siempre 1. Los demás valores de la matriz representan los valores p de las correlaciones entre pares de variables. Por ejemplo, el valor p de la correlación entre VALOR_VIVIENDA y PATRIMONIO es 0, lo que indica una correlación significativa al nivel de significación de 0,05. Del mismo modo, el valor p de la correlación entre VALOR_VIVIENDA e IMPORTE es 0, lo que indica una correlación significativa al nivel de significación 0,05. El valor p de la correlación entre SALDO y PATRIMONIO es 0,3203, lo que indica una correlación no significativa al nivel de significación de 0,05.

# si p-value < 0,05 el valor es significativo
round(correlacion_pvalue,4)
##                VALOR_VIVIENDA PATRIMONIO IMPORTE  CUOTA INGRESOS  SALDO  EDAD
## VALOR_VIVIENDA              0     0.0000  0.0000 0.0000   0.0000 0.0000 0e+00
## PATRIMONIO                  0     0.0000  0.0000 0.0000   0.0069 0.3203 0e+00
## IMPORTE                     0     0.0000  0.0000 0.0000   0.0000 0.5459 2e-02
## CUOTA                       0     0.0000  0.0000 0.0000   0.0000 0.1521 2e-04
## INGRESOS                    0     0.0069  0.0000 0.0000   0.0000 0.0000 0e+00
## SALDO                       0     0.3203  0.5459 0.1521   0.0000 0.0000 0e+00
## EDAD                        0     0.0000  0.0200 0.0002   0.0000 0.0000 0e+00

Utilizaremos la librería inspectdb para generar los coeficientes de correlación de Pearson, el p-value y los intervalos de confianza.

La tabla siguiente muestra las correlaciones entre pares de variables utilizando datos_num. También muestra los valores p, los límites inferior y superior del intervalo de confianza y el porcentaje de valores no ausentes para cada correlación.

La correlación positiva más fuerte es la existente entre CUOTA e IMPORTE, con un coeficiente de correlación de 0,91.

Hay varias correlaciones con valores p inferiores a 0,05, lo que indica una correlación estadísticamente significativa.

 x <- inspect_cor(datos_num)
 x1 <- as.data.frame(x)
 paged_table(x1)

Aquí puede verse una buena visualización de los coeficientes de correlación por pares.

 show_plot(x)

5 - Tablas de datos

Ahora vamos a observar algunas tablas de datos y centrar nuestro análisis en variables categóricas, que nos ayuden a comprender si existe alguna asociación o patrón entre nuestras variables a la hora de explicar nuestra variable objetivo CLASE.

table(datos$CLASE)
## 
##   NO   SI 
##  164 1482
round(prop.table(table(datos$CLASE)),2)
## 
##  NO  SI 
## 0.1 0.9

Contraste tabla de contingencia.

Creamos una tabla de contingencia de TIPO_VIVIENDA y CLASE. El resultado muestra que el estadístico chi-cuadrado de Pearson es 221,76 con 4 grados de libertad y un p valor inferior a 2,2e-16. Esto indica que existe una asociación significativa entre TIPO_VIVIENDA y CLASE.

t1 <- table(datos$TIPO_VIVIENDA,datos$CLASE)
addmargins(t1)
##                       
##                          NO   SI  Sum
##   Alquiler               72  128  200
##   Otros                  16   61   77
##   Propiedad hipotecada   28  562  590
##   Propiedad libre         6  457  463
##   Vive con la familia    42  274  316
##   Sum                   164 1482 1646
chisq.test(t1)
## 
##  Pearson's Chi-squared test
## 
## data:  t1
## X-squared = 221.76, df = 4, p-value < 2.2e-16

La siguiente tabla es entre las variables NACIONALIDAD y CLASE. Aquí utilizaremos CrossTable() de la librería gmodels en formato SPSS para una mejor visualización de los resultados. Como podemos ver, el valor p es muy pequeño proporcionando una fuerte evidencia contra la hipótesis nula de independencia entre las dos variables.

t2 <- table(datos$NACIONALIDAD,datos$CLASE)
addmargins(t2)
##             
##                NO   SI  Sum
##   Español      73 1336 1409
##   Extranjero   91  146  237
##   Sum         164 1482 1646
CrossTable(t2, expected = TRUE, format="SPSS")
## 
##    Cell Contents
## |-------------------------|
## |                   Count |
## |         Expected Values |
## | Chi-square contribution |
## |             Row Percent |
## |          Column Percent |
## |           Total Percent |
## |-------------------------|
## 
## Total Observations in Table:  1646 
## 
##              |  
##              |       NO  |       SI  | Row Total | 
## -------------|-----------|-----------|-----------|
##      Español |       73  |     1336  |     1409  | 
##              |  140.386  | 1268.614  |           | 
##              |   32.346  |    3.579  |           | 
##              |    5.181% |   94.819% |   85.601% | 
##              |   44.512% |   90.148% |           | 
##              |    4.435% |   81.166% |           | 
## -------------|-----------|-----------|-----------|
##   Extranjero |       91  |      146  |      237  | 
##              |   23.614  |  213.386  |           | 
##              |  192.301  |   21.280  |           | 
##              |   38.397% |   61.603% |   14.399% | 
##              |   55.488% |    9.852% |           | 
##              |    5.529% |    8.870% |           | 
## -------------|-----------|-----------|-----------|
## Column Total |      164  |     1482  |     1646  | 
##              |    9.964% |   90.036% |           | 
## -------------|-----------|-----------|-----------|
## 
##  
## Statistics for All Table Factors
## 
## 
## Pearson's Chi-squared test 
## ------------------------------------------------------------
## Chi^2 =  249.5069     d.f. =  1     p =  3.326196e-56 
## 
## Pearson's Chi-squared test with Yates' continuity correction 
## ------------------------------------------------------------
## Chi^2 =  245.818     d.f. =  1     p =  2.119287e-55 
## 
##  
##        Minimum expected frequency: 23.61361

Ahora observamos la variable ESTADO_CIVIL con CLASE. Aquí también el valor p es muy inferior a 0,05, lo que sugiere una fuerte asociación entre las dos variables.

t3 <- table(datos$ESTADO_CIVIL,datos$CLASE)
addmargins(t3)
##           
##              NO   SI  Sum
##   Casado     37  815  852
##   Separado   15   76   91
##   Soltero   112  591  703
##   Sum       164 1482 1646
CrossTable(t3, expected = TRUE, format="SPSS")
## 
##    Cell Contents
## |-------------------------|
## |                   Count |
## |         Expected Values |
## | Chi-square contribution |
## |             Row Percent |
## |          Column Percent |
## |           Total Percent |
## |-------------------------|
## 
## Total Observations in Table:  1646 
## 
##              |  
##              |       NO  |       SI  | Row Total | 
## -------------|-----------|-----------|-----------|
##       Casado |       37  |      815  |      852  | 
##              |   84.889  |  767.111  |           | 
##              |   27.016  |    2.990  |           | 
##              |    4.343% |   95.657% |   51.762% | 
##              |   22.561% |   54.993% |           | 
##              |    2.248% |   49.514% |           | 
## -------------|-----------|-----------|-----------|
##     Separado |       15  |       76  |       91  | 
##              |    9.067  |   81.933  |           | 
##              |    3.883  |    0.430  |           | 
##              |   16.484% |   83.516% |    5.529% | 
##              |    9.146% |    5.128% |           | 
##              |    0.911% |    4.617% |           | 
## -------------|-----------|-----------|-----------|
##      Soltero |      112  |      591  |      703  | 
##              |   70.044  |  632.956  |           | 
##              |   25.132  |    2.781  |           | 
##              |   15.932% |   84.068% |   42.710% | 
##              |   68.293% |   39.879% |           | 
##              |    6.804% |   35.905% |           | 
## -------------|-----------|-----------|-----------|
## Column Total |      164  |     1482  |     1646  | 
##              |    9.964% |   90.036% |           | 
## -------------|-----------|-----------|-----------|
## 
##  
## Statistics for All Table Factors
## 
## 
## Pearson's Chi-squared test 
## ------------------------------------------------------------
## Chi^2 =  62.23111     d.f. =  2     p =  3.066806e-14 
## 
## 
##  
##        Minimum expected frequency: 9.066829

Ahora utilizaremos variables cuantitativas en nuestro análisis para crear diferentes tablas por CLASE y obtener una buena visión de algunos números.

table1 <- datos %>%
  group_by(CLASE) %>%
  summarize(VALOR_VIVIENDA_Media = mean(VALOR_VIVIENDA, na.rm = TRUE),
            PATRIMONIO_Media = mean(PATRIMONIO, na.rm = TRUE),
            IMPORTE_Media = mean(IMPORTE, na.rm = TRUE),
            CUOTA_Media = mean(CUOTA, na.rm = TRUE),
            INGRESOS_Media = mean(INGRESOS, na.rm = TRUE),
            SALDO_Media = mean(SALDO, na.rm = TRUE),
            EDAD_Media = mean(EDAD, na.rm = TRUE)) %>%
  mutate(CLASE = factor(CLASE, levels = c("SI", "NO")))

# dar formato a la tabla utilizando flextable 
table1 = flextable(table1) %>%
  colformat_double(big.mark = ".",decimal.mark = ",",digits =2)%>%
  add_header_lines(values = "Valor de la media en función del tipo de cliente*")%>% 
  add_footer_lines(values = "Tipo de cliente ='SI',pagaron el crédito., 'NO',no pagaron el crédito")%>%
  color(color = "#993399", part = "header")%>%
  color(color = "chocolate4", part = "body")%>%
  color(color = "grey", part = "footer")%>%
  autofit()%>%
  align(align = "center", part = "all")

table1
table2 <- datos %>%
  group_by(TIPO_VIVIENDA, CLASE) %>%
  summarise(mean_VALOR_VIVIENDA = mean(VALOR_VIVIENDA, na.rm = TRUE),
            PATRIMONIO_Media = mean(PATRIMONIO, na.rm = TRUE),
            IMPORTE_Media = mean(IMPORTE, na.rm = TRUE),
            CUOTA_Media = mean(CUOTA, na.rm = TRUE),
            INGRESOS_Media = mean(INGRESOS, na.rm = TRUE),
            SALDO_Media = mean(SALDO, na.rm = TRUE),
            EDAD_Media = mean(EDAD, na.rm = TRUE))
## `summarise()` has grouped output by 'TIPO_VIVIENDA'. You can override using the
## `.groups` argument.
# dar formato a la tabla utilizando kablextra 
  kable_styling(kable(table2,
                    format ="html",
                    digits = c(NA,NA,2,2,2,2,2,2,2),
                    format.args = list(decimal.mark = ",", big.mark = "."),
                    row.names = F,
                    align = c("l","c","c","c","c"),
                    booktabs = T,
                    caption = "Tabla de TIPO_VIVIENDA con CLASE",
              latex_options = c("striped","condensed"),
              position = "center",
              full_width = F))
Tabla de TIPO_VIVIENDA con CLASE
TIPO_VIVIENDA CLASE mean_VALOR_VIVIENDA PATRIMONIO_Media IMPORTE_Media CUOTA_Media INGRESOS_Media SALDO_Media EDAD_Media
Alquiler NO 1.083,33 55,56 5.345,93 173,42 16.127,76 513,69 39,82
Alquiler SI 2.226,56 515,62 8.171,48 181,00 15.419,06 3.056,65 40,81
Otros NO 5.624,69 937,50 5.215,62 164,62 13.855,15 201,88 35,56
Otros SI 5.520,98 6.674,75 9.500,00 206,13 16.202,44 4.967,33 43,08
Propiedad hipotecada NO 96.851,50 8.575,21 7.778,14 172,96 17.154,12 330,50 38,81
Propiedad hipotecada SI 133.454,90 9.119,39 8.951,35 193,57 20.950,17 3.798,88 43,44
Propiedad libre NO 110.000,00 5.833,33 6.733,17 231,17 24.884,83 2.022,33 55,00
Propiedad libre SI 163.634,56 19.430,14 9.559,43 220,51 21.138,80 8.153,91 54,48
Vive con la familia NO 4.357,14 1.309,52 4.900,12 168,81 14.351,21 847,76 35,02
Vive con la familia SI 5.498,62 4.343,30 8.351,11 185,44 15.909,57 3.815,04 32,67 
table3 <- datos %>%
  group_by(NACIONALIDAD, CLASE) %>%
  summarise(mean_VALOR_VIVIENDA = mean(VALOR_VIVIENDA, na.rm = TRUE),
            PATRIMONIO_Media = mean(PATRIMONIO, na.rm = TRUE),
            IMPORTE_Media = mean(IMPORTE, na.rm = TRUE),
            CUOTA_Media = mean(CUOTA, na.rm = TRUE),
            INGRESOS_Media = mean(INGRESOS, na.rm = TRUE),
            SALDO_Media = mean(SALDO, na.rm = TRUE),
            EDAD_Media = mean(EDAD, na.rm = TRUE))
## `summarise()` has grouped output by 'NACIONALIDAD'. You can override using the
## `.groups` argument.
  kable_styling(kable(table3,
                    format ="html",
                    digits = c(NA,NA,2,2,2,2,2,2,2),
                    format.args = list(decimal.mark = ",", big.mark = "."),
                    row.names = F,
                    align = c("l","c","c","c","c"),
                    booktabs = T,
                    caption = "Tabla de NACIONALIDAD con CLASE",
              latex_options = c("striped","condensed"),
              position = "center",
              full_width = F))
Tabla de NACIONALIDAD con CLASE
NACIONALIDAD CLASE mean_VALOR_VIVIENDA PATRIMONIO_Media IMPORTE_Media CUOTA_Media INGRESOS_Media SALDO_Media EDAD_Media
Español NO 27.760,00 4.563,10 5.335,90 170,64 16.546,56 752,99 42,34
Español SI 110.500,63 11.641,39 9.013,95 201,31 19.943,49 5.526,55 45,20
Extranjero NO 18.641,29 175,82 5.965,14 175,64 15.536,12 464,20 35,68
Extranjero SI 29.330,15 787,67 8.700,92 186,07 14.447,35 1.489,16 38,72 
table4 <- datos %>%
  group_by(ESTADO_CIVIL, CLASE) %>%
  summarise(mean_VALOR_VIVIENDA = mean(VALOR_VIVIENDA, na.rm = TRUE),
            PATRIMONIO_Media = mean(PATRIMONIO, na.rm = TRUE),
            IMPORTE_Media = mean(IMPORTE, na.rm = TRUE),
            CUOTA_Media = mean(CUOTA, na.rm = TRUE),
            INGRESOS_Media = mean(INGRESOS, na.rm = TRUE),
            SALDO_Media = mean(SALDO, na.rm = TRUE),
            EDAD_Media = mean(EDAD, na.rm = TRUE))
## `summarise()` has grouped output by 'ESTADO_CIVIL'. You can override using the
## `.groups` argument.
  kable_styling(kable(table4,
                    format ="html",
                    digits = c(NA,NA,2,2,2,2,2,2,2),
                    format.args = list(decimal.mark = ",", big.mark = "."),
                    row.names = F,
                    align = c("l","c","c","c","c"),
                    booktabs = T,
                    caption = "Tabla de ESTADO_CIVIL con CLASE",
              latex_options = c("striped","condensed"),
              position = "center",
              full_width = F))
Tabla de ESTADO_CIVIL con CLASE
ESTADO_CIVIL CLASE mean_VALOR_VIVIENDA PATRIMONIO_Media IMPORTE_Media CUOTA_Media INGRESOS_Media SALDO_Media EDAD_Media
Casado NO 60.661,62 4.056,92 6.987,49 179,95 17.840,76 434,19 41,41
Casado SI 127.764,66 14.042,34 9.269,86 207,47 19.637,23 5.634,55 48,37
Separado NO 30.690,80 1.000,00 4.939,47 156,67 20.178,13 234,53 47,20
Separado SI 112.074,12 12.577,78 8.370,78 181,36 23.742,52 4.191,68 48,92
Soltero NO 9.089,24 1.642,86 5.354,64 173,50 14.788,81 693,10 36,44
Soltero SI 66.438,61 5.528,72 8.666,42 191,60 18.441,11 4.551,87 38,77

6 - Análisis gráfico

Podemos utilizar varios métodos de representación gráfica de las variables independientes para comprender su influencia en la variable dependiente. Utilizaremos diferentes estilos como diagramas de barras, diagramas de dispersión, histogramas, diagramas de caja. Para ello, utilizaremos gráficos de la librería ggplot2 que ofrece múltiples formas para representar información gráficamente.

Definiremos una función para crear gráficos de dispersión. Lo visualizaremos según los niveles de la variable dependiente. También se añade una línea de tendencia general que muestra el intervalo de confianza.

graf_dispersion <- function(var1,var2){
  dat <- datos[, c(var1, var2, "CLASE"), with = FALSE]
  ggplot(data = dat, aes_string(x = var1, y = var2)) +
    geom_point(aes_string(col = "CLASE")) +
    geom_smooth() +
    ggtitle('Gráfico Scatter Plot') +
    theme(plot.title = element_text(color = "blue", hjust = 0.5)) +
    labs(x = var1, y = var2)  
}
graf_dispersion("IMPORTE","INGRESOS")
## Warning: `aes_string()` was deprecated in ggplot2 3.0.0.
## ℹ Please use tidy evaluation ideoms with `aes()`
## `geom_smooth()` using method = 'gam' and formula = 'y ~ s(x, bs = "cs")'
## Warning: Removed 84 rows containing non-finite values (`stat_smooth()`).
## Warning: Removed 84 rows containing missing values (`geom_point()`).

graf_dispersion("SALDO","EDAD")
## `geom_smooth()` using method = 'gam' and formula = 'y ~ s(x, bs = "cs")'
## Warning: Removed 62 rows containing non-finite values (`stat_smooth()`).
## Warning: Removed 62 rows containing missing values (`geom_point()`).

graf_dispersion("VALOR_VIVIENDA","PATRIMONIO")
## `geom_smooth()` using method = 'gam' and formula = 'y ~ s(x, bs = "cs")'

Algunos gráficos con histogramas:

hist1 = ggplot(datos, aes(x = IMPORTE)) +
  geom_histogram(aes(y=..density..), colour="black", fill = "lightblue") +
  geom_density(alpha = .2, fill = "#FF6666") +
  ggtitle("Histograma IMPORTE") +
  theme(plot.title = element_text(color = "black")) +
  facet_grid(CLASE ~.)
hist1
## Warning: The dot-dot notation (`..density..`) was deprecated in ggplot2 3.4.0.
## ℹ Please use `after_stat(density)` instead.
## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.

hist1 = ggplot(datos, aes(x = INGRESOS)) +
  geom_histogram(aes(y=..density..), colour="black", fill = "lightblue") +
  geom_density(alpha = .2, fill = "#FF6666") +
  ggtitle("Histograma INGRESOS") +
  theme(plot.title = element_text(color = "black")) +
  facet_grid(CLASE ~.)
hist1
## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.
## Warning: Removed 84 rows containing non-finite values (`stat_bin()`).
## Warning: Removed 84 rows containing non-finite values (`stat_density()`).

hist1 = ggplot(datos, aes(x = EDAD)) +
  geom_histogram(aes(y=..density..), colour="black", fill = "lightblue") +
  geom_density(alpha = .2, fill = "#FF6666") +
  ggtitle("Histograma EDAD") +
  theme(plot.title = element_text(color = "black")) +
  facet_grid(CLASE ~.)
hist1
## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.
## Warning: Removed 62 rows containing non-finite values (`stat_bin()`).
## Warning: Removed 62 rows containing non-finite values (`stat_density()`).

Ahora utilizamos el diagrama de cajas para cada variable numérica independiente frente a la variable dependiente categórica CLASE (NO y SI) y, añadimos una comparación estadística de medias utilizando una prueba t. El gráfico muestra la distribución de la variable independiente para cada grupo y nos permite comparar las medianas, los cuartiles y el rango de los dos grupos. La comparación estadística indica si existe una diferencia significativa entre las medias de los dos grupos.

#  Diagramas de cajas (con p-value para el contraste t de student)
# variable VALOR_VIVIENDA
ggplot(data = datos, aes(x = CLASE, y= VALOR_VIVIENDA)) +
  geom_boxplot(color = 'darkorchid4') + 
  ggtitle("Box Plot entre CLASE y VALOR_VIVIENDA")+ 
  stat_compare_means(comparisons = list(c("NO", "SI")), method = "t.test")

Para entender correctamente si las varianzas de los grupos son iguales o no y para sacar conclusiones sobre la significación del gráfico anterior, realizaremos una prueba de homogeneidad de varianzas. Utilizaremos dos pruebas porque en algunos casos pueden dar valores p diferentes (aunque podemos utilizar cualquiera).

La prueba de Levene es una prueba paramétrica que comprueba si las varianzas de los grupos son iguales. Supone que los datos se distribuyen normalmente, y el estadístico de la prueba se basa en las desviaciones absolutas de los datos respecto a las medias de los grupos. Un resultado significativo (valor p < 0,05) sugiere que las varianzas son diferentes, lo que viola el supuesto de homogeneidad de la varianza.

La prueba de Fligner-Killeen es una alternativa no paramétrica a la prueba de Levene. Se basa en las medianas de las desviaciones absolutas de las medianas de grupo, lo que la hace más robusta a las desviaciones de la normalidad. Al igual que la prueba de Levene, un resultado significativo sugiere que las varianzas de los grupos son diferentes.

fligner.test(VALOR_VIVIENDA ~ CLASE, data = datos)
## 
##  Fligner-Killeen test of homogeneity of variances
## 
## data:  VALOR_VIVIENDA by CLASE
## Fligner-Killeen:med chi-squared = 130.35, df = 1, p-value < 2.2e-16
leveneTest(VALOR_VIVIENDA ~ CLASE, data = datos, center = "median")
## Levene's Test for Homogeneity of Variance (center = "median")
##         Df F value    Pr(>F)    
## group    1  94.317 < 2.2e-16 ***
##       1644                      
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
# variable PATRIMONIO
ggplot(data = datos, aes(x = CLASE, y= PATRIMONIO)) +
  geom_boxplot(color = 'darkorchid4') + 
  ggtitle("Box Plot entre CLASE y PATRIMONIO")+ 
  stat_compare_means(comparisons = list(c("NO", "SI")), method = "t.test")

fligner.test(PATRIMONIO ~ CLASE, data = datos)
## 
##  Fligner-Killeen test of homogeneity of variances
## 
## data:  PATRIMONIO by CLASE
## Fligner-Killeen:med chi-squared = 13.835, df = 1, p-value = 0.0001996
leveneTest(PATRIMONIO ~ CLASE, data = datos, center = "median")
## Levene's Test for Homogeneity of Variance (center = "median")
##         Df F value  Pr(>F)  
## group    1  6.3009 0.01216 *
##       1644                  
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
# variable IMPORTE
ggplot(data = datos, aes(x = CLASE, y= IMPORTE)) +
  geom_boxplot(color = 'darkorchid4') + 
  ggtitle("Box Plot entre CLASE y IMPORTE")+ 
  stat_compare_means(comparisons = list(c("NO", "SI")), method = "t.test")

fligner.test(IMPORTE ~ CLASE, data = datos)
## 
##  Fligner-Killeen test of homogeneity of variances
## 
## data:  IMPORTE by CLASE
## Fligner-Killeen:med chi-squared = 15.622, df = 1, p-value = 7.733e-05
leveneTest(IMPORTE ~ CLASE, data = datos, center = "median")
## Levene's Test for Homogeneity of Variance (center = "median")
##         Df F value    Pr(>F)    
## group    1  14.762 0.0001266 ***
##       1644                      
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
# variable CUOTA
ggplot(data = datos, aes(x = CLASE, y= CUOTA)) +
  geom_boxplot(color = 'darkorchid4') + 
  ggtitle("Box Plot entre CLASE y CUOTA")+ 
  stat_compare_means(comparisons = list(c("NO", "SI")), method = "t.test")

fligner.test(CUOTA ~ CLASE, data = datos)
## 
##  Fligner-Killeen test of homogeneity of variances
## 
## data:  CUOTA by CLASE
## Fligner-Killeen:med chi-squared = 18.218, df = 1, p-value = 1.97e-05
leveneTest(CUOTA ~ CLASE, data = datos, center = "median")
## Levene's Test for Homogeneity of Variance (center = "median")
##         Df F value    Pr(>F)    
## group    1  12.977 0.0003247 ***
##       1644                      
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
# variable INGRESOS
ggplot(data = datos, aes(x = CLASE, y= INGRESOS)) +
  geom_boxplot(color = 'darkorchid4') + 
  ggtitle("Box Plot entre CLASE y INGRESOS")+ 
  stat_compare_means(comparisons = list(c("NO", "SI")), method = "t.test")
## Warning: Removed 84 rows containing non-finite values (`stat_boxplot()`).
## Warning: Removed 84 rows containing non-finite values (`stat_signif()`).

fligner.test(INGRESOS ~ CLASE, data = datos)
## 
##  Fligner-Killeen test of homogeneity of variances
## 
## data:  INGRESOS by CLASE
## Fligner-Killeen:med chi-squared = 22.953, df = 1, p-value = 1.66e-06
leveneTest(INGRESOS ~ CLASE, data = datos, center = "median")
## Levene's Test for Homogeneity of Variance (center = "median")
##         Df F value    Pr(>F)    
## group    1  14.706 0.0001306 ***
##       1560                      
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
# variable SALDO
ggplot(data = datos, aes(x = CLASE, y= SALDO)) +
  geom_boxplot(color = 'darkorchid4') + 
  ggtitle("Box Plot entre CLASE y SALDO")+ 
  stat_compare_means(comparisons = list(c("NO", "SI")), method = "t.test")

fligner.test(SALDO ~ CLASE, data = datos)
## 
##  Fligner-Killeen test of homogeneity of variances
## 
## data:  SALDO by CLASE
## Fligner-Killeen:med chi-squared = 156.7, df = 1, p-value < 2.2e-16
leveneTest(SALDO ~ CLASE, data = datos, center = "median")
## Levene's Test for Homogeneity of Variance (center = "median")
##         Df F value    Pr(>F)    
## group    1  13.783 0.0002121 ***
##       1644                      
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
# variable EDAD
ggplot(data = datos, aes(x = CLASE, y= EDAD)) +
  geom_boxplot(color = 'darkorchid4') + 
  ggtitle("Box Plot entre CLASE y EDAD")+ 
  stat_compare_means(comparisons = list(c("NO", "SI")), method = "t.test")
## Warning: Removed 62 rows containing non-finite values (`stat_boxplot()`).
## Warning: Removed 62 rows containing non-finite values (`stat_signif()`).

fligner.test(EDAD ~ CLASE, data = datos)
## 
##  Fligner-Killeen test of homogeneity of variances
## 
## data:  EDAD by CLASE
## Fligner-Killeen:med chi-squared = 3.2641, df = 1, p-value = 0.07081
leveneTest(EDAD ~ CLASE, data = datos, center = "median")
## Levene's Test for Homogeneity of Variance (center = "median")
##         Df F value  Pr(>F)  
## group    1  2.8727 0.09029 .
##       1582                  
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

Pasemos ahora a las variables categóricas. Utilizaremos gráficos de barras para interpretar qué niveles de la variable independiente tienen una mayor influencia en la variable dependiente. El gráfico de barras nos permite comparar visualmente la distribución de la variable dependiente entre las distintas categorías de la variable independiente e identificar posibles patrones o diferencias.

En el caso del tipo de vivienda, tener Propiedad hipotecada y Propiedad libre parece tener mucha más influencia en el pago del préstamo que otras. Vivir con la familia también tiene cierta influencia en los préstamos pagados.

ggplot(datos, aes( x = CLASE)) + 
  geom_bar(colour = "darkorchid4",fill = "lightblue") + 
  facet_grid(. ~ TIPO_VIVIENDA) +
  ggtitle("Préstamo pagado o no vs tipo de vivienda")

En el caso de la Nacionalidad, parece que influye más ser español que extranjero, ya que la mayoría de los españoles han devuelto sus préstamos.

ggplot(datos, aes( x = CLASE)) + 
  geom_bar(colour = "darkorchid4",fill = "lightblue") + 
  facet_grid(. ~ NACIONALIDAD) +
  ggtitle("Préstamo pagado o no vs nacionalidad")

En caso de estado civil, ser casado y soltero parece influir en que se pague el préstamo. Separado no tiene mucha influencia en si el préstamo se paga o no.

ggplot(datos, aes( x = CLASE)) + 
  geom_bar(colour = "darkorchid4",fill = "lightblue") + 
  facet_grid(. ~ ESTADO_CIVIL) +
  ggtitle("Préstamo pagado o no vs estado civil")

En nuestros análisis hasta ahora podemos decir que muchas variables han mostrado una buena asociación o influencia en la explicación de la variable dependiente. VALOR_VIVIENDA,IMPORTE,CUOTA,INGRESOS,SALDO todas ellas tienen una p-value más baja y sugieren que son significativas a la hora de explicar si el préstamo se paga o no. Por otro lado, las variables categóricas PATRIMONIO,EDAD mostraron resultados no significativos.

Considerando las variables categóricas,TIPO_VIVIENDA,NACIONALIDAD,ESTADO_CIVIL todas han mostrado alguna asociación con CLASE.

7 - Imputación de los valores ausentes

En primer lugar vamos a ver qué datos faltan de diferentes maneras.

Usando la función básica de R.

sapply(datos,
function(x) sum(is.na(x)))
##  TIPO_VIVIENDA VALOR_VIVIENDA     PATRIMONIO   NACIONALIDAD        IMPORTE 
##              0              0              0              0              0 
##          CUOTA       INGRESOS          SALDO           EDAD   ESTADO_CIVIL 
##              0             84              0             62              0 
##          CLASE 
##              0

Usando plot_missing() de la librería dataExplorer

plot_missing(datos)

Como podemos ver en los resultados anteriores, en nuestro conjunto de datos faltan datos. Ahora procederemos a comprobar si siguen algún patrón o mantienen la estructura y los trataremos en consecuencia.

md.pattern(datos, rotate.names = T)

##      TIPO_VIVIENDA VALOR_VIVIENDA PATRIMONIO NACIONALIDAD IMPORTE CUOTA SALDO
## 1504             1              1          1            1       1     1     1
## 80               1              1          1            1       1     1     1
## 58               1              1          1            1       1     1     1
## 4                1              1          1            1       1     1     1
##                  0              0          0            0       0     0     0
##      ESTADO_CIVIL CLASE EDAD INGRESOS    
## 1504            1     1    1        1   0
## 80              1     1    1        0   1
## 58              1     1    0        1   1
## 4               1     1    0        0   2
##                 0     0   62       84 146

Podemos ver que faltan valores en dos variables: EDAD e INGRESOS. La tabla anterior muestra que en 1504 filas todas las variables están presentes. En 80 filas todas las variables están presentes excepto INGRESOS. De forma similar, en 58 filas sólo falta EDAD y en 4 filas faltan EDAD e INGRESOS. También podemos ver los datos ausentes utilizando la librería VIM. Aquí podemos ver el porcentaje de valores ausentes en cada variable.

aggr(datos,col = c('navyblue','red'),numbers = T,sortVars = T,labels = names(datos),
     cex.axis = 0.7,gap = 3,ylab = c("hist de valores perdidos","estructura"))

## 
##  Variables sorted by number of missings: 
##        Variable      Count
##        INGRESOS 0.05103281
##            EDAD 0.03766707
##   TIPO_VIVIENDA 0.00000000
##  VALOR_VIVIENDA 0.00000000
##      PATRIMONIO 0.00000000
##    NACIONALIDAD 0.00000000
##         IMPORTE 0.00000000
##           CUOTA 0.00000000
##           SALDO 0.00000000
##    ESTADO_CIVIL 0.00000000
##           CLASE 0.00000000

Después de ver los valores ausentes que tenemos en nuestro conjunto de datos, no se observa ningún patrón visible aquí.Debemos comprobar su aleatoriedad y para ello, utilizamos la librería Naniar.

mcar_test(datos)
## # A tibble: 1 × 4
##   statistic    df p.value missing.patterns
##       <dbl> <dbl>   <dbl>            <int>
## 1      36.4    29   0.163                4

El valor p de 0,163408 sugiere que no podemos rechazar la hipótesis nula de MCAR a un nivel de significación de 0,05, lo que significa que los datos ausentes en el conjunto de datos faltan completamente al azar.

Antes de proceder a la imputación del conjunto de datos, es una buena práctica ver los resultados antes y después de dicha imputación, por lo que registramos el valor medio de cada columna sin tener en cuenta los valores que faltan para compararlos después de la imputación.

datos_sinNA_num = na.omit(datos_num)

dim(datos_sinNA_num)
## [1] 1504    7
sum(is.na(datos_sinNA_num))
## [1] 0
round(apply(datos_sinNA_num, 2, mean),2)
## VALOR_VIVIENDA     PATRIMONIO        IMPORTE          CUOTA       INGRESOS 
##       93327.87        9758.94        8654.50         196.87       19029.13 
##          SALDO           EDAD 
##        4576.34          43.99

Imputación de los valores ausentes

Ahora podemos proceder a imputar los datos que faltan.

Para ello vamos a utilizar tres métodos diferentes:

1.Método PMM(predictive mean matching ) de la librería mice.

2.Metodo árboles CART de la librería mice.

3.Los K-vecinos, de la librería DMwR.

Utilizando el método PMM:

imputed_data_pmm = mice(datos,m=5,verbose=T) #El método pmm está por defecto en MICE
## 
##  iter imp variable
##   1   1  INGRESOS  EDAD
##   1   2  INGRESOS  EDAD
##   1   3  INGRESOS  EDAD
##   1   4  INGRESOS  EDAD
##   1   5  INGRESOS  EDAD
##   2   1  INGRESOS  EDAD
##   2   2  INGRESOS  EDAD
##   2   3  INGRESOS  EDAD
##   2   4  INGRESOS  EDAD
##   2   5  INGRESOS  EDAD
##   3   1  INGRESOS  EDAD
##   3   2  INGRESOS  EDAD
##   3   3  INGRESOS  EDAD
##   3   4  INGRESOS  EDAD
##   3   5  INGRESOS  EDAD
##   4   1  INGRESOS  EDAD
##   4   2  INGRESOS  EDAD
##   4   3  INGRESOS  EDAD
##   4   4  INGRESOS  EDAD
##   4   5  INGRESOS  EDAD
##   5   1  INGRESOS  EDAD
##   5   2  INGRESOS  EDAD
##   5   3  INGRESOS  EDAD
##   5   4  INGRESOS  EDAD
##   5   5  INGRESOS  EDAD

Comprobamos qué método se ha utilizado:

imputed_data_pmm$meth
##  TIPO_VIVIENDA VALOR_VIVIENDA     PATRIMONIO   NACIONALIDAD        IMPORTE 
##             ""             ""             ""             ""             "" 
##          CUOTA       INGRESOS          SALDO           EDAD   ESTADO_CIVIL 
##             ""          "pmm"             ""          "pmm"             "" 
##          CLASE 
##             ""

Imputación del conjunto de datos

datos_imputados_pmm = complete(imputed_data_pmm)

Podemos ver que ya no faltan datos.

sapply(datos_imputados_pmm, function(x) sum(is.na(x)))
##  TIPO_VIVIENDA VALOR_VIVIENDA     PATRIMONIO   NACIONALIDAD        IMPORTE 
##              0              0              0              0              0 
##          CUOTA       INGRESOS          SALDO           EDAD   ESTADO_CIVIL 
##              0              0              0              0              0 
##          CLASE 
##              0
dim(datos_imputados_pmm)
## [1] 1646   11
datos_numNA_pmm= subset(datos_imputados_pmm, select = c("VALOR_VIVIENDA","PATRIMONIO","IMPORTE","CUOTA","INGRESOS","SALDO","EDAD")) #Selecting numerical variables to later compare their means

Ahora comparamos las variables del conjunto de datos original -sin los NA- frente a las del conjunto completo con los datos imputados.

par(mfrow=c(1,2))
plot(density(datos$EDAD,na.rm = T),col=2,main="Variable EDAD. Método pmm")
lines(density(datos_imputados_pmm$EDAD),col=3)
plot(density(datos$INGRESOS,na.rm = T),col=2,main="Variable INGRESOS. Método pmm")
lines(density(datos_imputados_pmm$INGRESOS),col=3)

Pasando a nuestro segundo método, utilizamos Metodo árboles CART de librería MICE.

imputed_data_cart <- mice(datos, meth = "cart", minbucket = 4)
## 
##  iter imp variable
##   1   1  INGRESOS  EDAD
##   1   2  INGRESOS  EDAD
##   1   3  INGRESOS  EDAD
##   1   4  INGRESOS  EDAD
##   1   5  INGRESOS  EDAD
##   2   1  INGRESOS  EDAD
##   2   2  INGRESOS  EDAD
##   2   3  INGRESOS  EDAD
##   2   4  INGRESOS  EDAD
##   2   5  INGRESOS  EDAD
##   3   1  INGRESOS  EDAD
##   3   2  INGRESOS  EDAD
##   3   3  INGRESOS  EDAD
##   3   4  INGRESOS  EDAD
##   3   5  INGRESOS  EDAD
##   4   1  INGRESOS  EDAD
##   4   2  INGRESOS  EDAD
##   4   3  INGRESOS  EDAD
##   4   4  INGRESOS  EDAD
##   4   5  INGRESOS  EDAD
##   5   1  INGRESOS  EDAD
##   5   2  INGRESOS  EDAD
##   5   3  INGRESOS  EDAD
##   5   4  INGRESOS  EDAD
##   5   5  INGRESOS  EDAD
datos_imputados_cart = complete(imputed_data_cart)
datos_numNA_cart= subset(datos_imputados_cart, select = c("VALOR_VIVIENDA","PATRIMONIO","IMPORTE","CUOTA","INGRESOS","SALDO","EDAD"))
par(mfrow=c(1,2))
plot(density(datos$EDAD,na.rm = T),col=2,main="Variable EDAD. Método CART")
lines(density(datos_imputados_cart$EDAD),col=3)
plot(density(datos$INGRESOS,na.rm = T),col=2,main="Variable INGRESOS. Método CART")
lines(density(datos_imputados_cart$INGRESOS),col=3)

Nuestro tercer enfoque es a través de los K-vecinos, de la librería DMwR.

datos_imputados_knn = knnImputation(datos)


datos_numNA_knn= subset(datos_imputados_knn, select = c("VALOR_VIVIENDA","PATRIMONIO","IMPORTE","CUOTA","INGRESOS","SALDO","EDAD"))


# Comprobamos que ya no existen valores ausentes

sapply(datos_imputados_knn, function(x) sum(is.na(x)))
##  TIPO_VIVIENDA VALOR_VIVIENDA     PATRIMONIO   NACIONALIDAD        IMPORTE 
##              0              0              0              0              0 
##          CUOTA       INGRESOS          SALDO           EDAD   ESTADO_CIVIL 
##              0              0              0              0              0 
##          CLASE 
##              0
par(mfrow=c(1,2))
plot(density(datos$EDAD,na.rm = T),col=2,main="Variable EDAD. Método knn")
lines(density(datos_imputados_knn$EDAD),col=3)
plot(density(datos$INGRESOS,na.rm = T),col=2,main="Variable INGRESOS. Método knn")
lines(density(datos_imputados_knn$INGRESOS),col=3)

Observando las representaciones gráficas anteriores, no podemos concluir qué método da mejores resultados, ya que todos ellos captan bien los patrones subyacentes y la variabilidad de los datos. Procedamos a comparar las medias de cada variable de todos los métodos que hemos utilizado y también con los datos originales sin considerar sus valores ausentes.

print("Medias de las variables numéricas originales")
## [1] "Medias de las variables numéricas originales"
round(apply(datos_sinNA_num, 2, mean, na.rm=TRUE),2)
## VALOR_VIVIENDA     PATRIMONIO        IMPORTE          CUOTA       INGRESOS 
##       93327.87        9758.94        8654.50         196.87       19029.13 
##          SALDO           EDAD 
##        4576.34          43.99
print("Medias de las variables numéricas. Método PMM")
## [1] "Medias de las variables numéricas. Método PMM"
round(apply(datos_numNA_pmm, 2, mean),2)
## VALOR_VIVIENDA     PATRIMONIO        IMPORTE          CUOTA       INGRESOS 
##       94552.79        9730.86        8654.51         197.18       19004.57 
##          SALDO           EDAD 
##        4676.85          44.05
print("Medias de las variables numéricas. Árbol CART")
## [1] "Medias de las variables numéricas. Árbol CART"
round(apply(datos_numNA_cart, 2, mean),2)
## VALOR_VIVIENDA     PATRIMONIO        IMPORTE          CUOTA       INGRESOS 
##       94552.79        9730.86        8654.51         197.18       18979.31 
##          SALDO           EDAD 
##        4676.85          43.95
print("Medias de las variables numéricas. Método K-Vecinos")
## [1] "Medias de las variables numéricas. Método K-Vecinos"
round(apply(datos_numNA_knn, 2, mean),2)
## VALOR_VIVIENDA     PATRIMONIO        IMPORTE          CUOTA       INGRESOS 
##       94552.79        9730.86        8654.51         197.18       19064.20 
##          SALDO           EDAD 
##        4676.85          43.97

Si se comparan las medias de los datos originales y de los datos imputados por los tres métodos diferentes, se observa que las medias de los datos imputados por los tres métodos se aproximan mucho a las medias de los datos originales. Sin embargo, las medias de los datos imputados por el método k-vecinos están ligeramente más cerca de las medias de los datos originales que las de los otros dos métodos.

Por lo tanto, basándonos en las medias de los datos imputados, podemos concluir que el método de imputación K-NN puede utilizarse para imputar valores ausentes en el conjunto de datos dado.

8 - Tratamiento de los valores anómalos

Los valores atípicos suelen identificarse como observaciones que se alejan del resto de los puntos de datos. Para encontrar valores atípicos en nuestro conjunto de datos existen muchos métodos. En nuestro caso, ninguno de los niveles de las variables categóricas tiene una proporción demasiado baja en los datos, por lo que consideraremos variables numéricas imputadas con el método k-vecinos.

par(mfrow=c(2,4))
boxplot(datos_numNA_knn$VALOR_VIVIENDA)
boxplot(datos_numNA_knn$PATRIMONIO)
boxplot(datos_numNA_knn$IMPORTE)
boxplot(datos_numNA_knn$CUOTA)
boxplot(datos_numNA_knn$INGRESOS)
boxplot(datos_numNA_knn$SALDO)
boxplot(datos_numNA_knn$EDAD)

Usamos las funciones diagnose_outlier y plot_outlier de la librería dlookr. Esto nos da una información muy buena y detallada acerca de los valores atípicos.Esto también muestra el cambio en los datos con y sin valores atípicos simultáneamente.

variables <- c("VALOR_VIVIENDA","PATRIMONIO","IMPORTE","CUOTA","INGRESOS","SALDO","EDAD")

datos_imputados_knn %>%  diagnose_outlier(variables)
## Warning: Using an external vector in selections was deprecated in tidyselect 1.1.0.
## ℹ Please use `all_of()` or `any_of()` instead.
##   # Was:
##   data %>% select(variables)
## 
##   # Now:
##   data %>% select(all_of(variables))
## 
## See <https://tidyselect.r-lib.org/reference/faq-external-vector.html>.
##                     variables outliers_cnt outliers_ratio outliers_mean
## VALOR_VIVIENDA VALOR_VIVIENDA           24      1.4580802   554625.3333
## PATRIMONIO         PATRIMONIO          281     17.0716889    57000.0000
## IMPORTE               IMPORTE           65      3.9489672    28592.8462
## CUOTA                   CUOTA           43      2.6123937      595.4419
## INGRESOS             INGRESOS           81      4.9210207    52543.0864
## SALDO                   SALDO          197     11.9684083    28000.8782
## EDAD                     EDAD            2      0.1215067       86.0000
##                  with_mean without_mean
## VALOR_VIVIENDA 94552.78554   87745.3002
## PATRIMONIO      9730.86270       0.0000
## IMPORTE         8654.50729    7834.7780
## CUOTA            197.17558     186.4922
## INGRESOS       19064.20204   17331.4291
## SALDO           4676.84872    1505.8109
## EDAD              43.97473      43.9236
datos_imputados_knn %>%  plot_outlier()

datos_imputados_knn %>%   target_by(CLASE) %>%   plot_outlier(variables)

Dado que el tema del tratamiento de los valores atípicos es muy delicado,depende de nuestro objetivo de análisis y también de cómo se haya mantenido el conjunto de datos, debemos ser conscientes de no modificar demasiado el conjunto de datos.En la práctica, preprocesar los datos tratando los valores atípicos tiende a producir resultados más precisos en presencia de datos no vistos. En nuestro caso, utilizaremos dos métodos para tratar los valores atípicos.

1.Método Tukey: Este método marca los valores atípicos teniendo en cuenta los valores de los cuartiles, Q1, Q2 y Q3, donde Q1 equivale al percentil 25, Q2 al percentil 50 (también conocido como mediana) y Q3 es el percentil 75. Estamos utilizando type=‘stop’ ya que esto convertirá los valores fuera del umbral en umbral. Si tuviéramos que convertirlos en ‘NA’, habríamos utilizado type=“set_na”, pero como ya hemos tratado los valores que faltan y además necesitamos este modelo para la modelización predictiva, sustituiremos los valores atípicos por valores umbral.

set.seed(10) 

df_tukey=prep_outliers(data = datos_imputados_knn, input = variables, type='stop', method = "tukey")
## Warning in prep_outliers(data = datos_imputados_knn, input = variables, : Skip
## the transformation (top value) for some variables because the threshold would
## have left them with 1 unique value. Variable list printed in the console.
## Variables to adjust top threshold: PATRIMONIO

2.Reemplazando los valores atípicos por la mediana.

set.seed(10) 
#Identificar los valores atípicos y sustituirlos por la mediana
df_median = datos_imputados_knn  #hacer una copia de los datos
cols <- names(df_median)[sapply(df_median, is.numeric)]
for (i in cols) {
  q1 <- quantile(df_median[[i]], 0.25)
  q3 <- quantile(df_median[[i]], 0.75)
  iqr <- q3 - q1
  fence1 <- q1 - 1.5 * iqr
  fence2 <- q3 + 1.5 * iqr
  outliers <- df_median[[i]] < fence1 | df_median[[i]] > fence2
  if (any(outliers)) {
    df_median[outliers, (i) := median(df_median[[i]], na.rm = TRUE)]
  }
}

Ahora se comparan las estadísticas de los datos originales y los datos obtenidos después de tratarlos con dos métodos.

profiling_num(datos_imputados_knn) %>% select(variable, mean, std_dev, variation_coef) #datos antes de la imputación
##         variable       mean     std_dev variation_coef
## 1 VALOR_VIVIENDA 87559.4635 89852.69605      1.0261906
## 2     PATRIMONIO     0.0000     0.00000            NaN
## 3        IMPORTE  7880.7922  5123.86950      0.6501719
## 4          CUOTA   186.6622   101.37192      0.5430768
## 5       INGRESOS 17294.5988  7585.49605      0.4386049
## 6          SALDO  1426.7224  1984.33862      1.3908373
## 7           EDAD    43.9237    12.04825      0.2742995
profiling_num(df_tukey) %>% select(variable, mean, std_dev, variation_coef) #Datos tras aplicar el método tukey
##         variable        mean      std_dev variation_coef
## 1 VALOR_VIVIENDA 93645.73815 102539.71088      1.0949747
## 2     PATRIMONIO  9730.86270  40940.12904      4.2072456
## 3        IMPORTE  8619.14885   6452.02268      0.7485684
## 4          CUOTA   196.30377    118.27922      0.6025316
## 5       INGRESOS 18895.73560  10326.56950      0.5465026
## 6          SALDO  2983.78159   4513.85526      1.5127968
## 7           EDAD    43.97473     12.13794      0.2760208
profiling_num(df_median) %>% select(variable, mean, std_dev, variation_coef)#Datos tras aplicar el método de la mediana
##         variable       mean     std_dev variation_coef
## 1 VALOR_VIVIENDA 87559.4635 89852.69605      1.0261906
## 2     PATRIMONIO     0.0000     0.00000            NaN
## 3        IMPORTE  7880.7922  5123.86950      0.6501719
## 4          CUOTA   186.6622   101.37192      0.5430768
## 5       INGRESOS 17294.5988  7585.49605      0.4386049
## 6          SALDO  1426.7224  1984.33862      1.3908373
## 7           EDAD    43.9237    12.04825      0.2742995

Hemos aplicado dos métodos de imputación de valores atípicos y hemos comparado sus resultados. Observamos que no hay mucha diferencia en general cuando se aplica el método Tukey y los valores atípicos se han sustituido por valores umbral, sólo unas pocas variables muestran diferencias en los valores medios. Por otra parte, los valores medios cuando los valores atípicos se sustituyen por medianas, son mucho más similares a los valores antes de la imputación. En el caso de la variable PATRIMONIO, el valor medio es cero porque hay demasiados ceros en los datos. Podemos ignorarlos porque no me parece lógico sustituirlos por ningún otro valor. Dado que los resultados son algo similares a los del conjunto de datos original sin imputación, seguiremos adelante únicamente con este ultimo conjunto de datos(datos_imputados_knn).

9 - Equilibrado de la muestra

Antes de proceder al equilibrado de la muestra, vamos a tomar sólo aquellas variables que son significativas para predecir la CLASE

modelo = glm(CLASE ~., data = datos_imputados_knn, family = "binomial")
summary(modelo)
## 
## Call:
## glm(formula = CLASE ~ ., family = "binomial", data = datos_imputados_knn)
## 
## Deviance Residuals: 
##     Min       1Q   Median       3Q      Max  
## -3.7137   0.1013   0.1964   0.3730   1.9462  
## 
## Coefficients: (1 not defined because of singularities)
##                                     Estimate Std. Error z value Pr(>|z|)    
## (Intercept)                        2.244e+00  6.122e-01   3.665 0.000247 ***
## TIPO_VIVIENDAOtros                 1.582e-01  3.834e-01   0.413 0.679833    
## TIPO_VIVIENDAPropiedad hipotecada  6.994e-01  3.860e-01   1.812 0.069982 .  
## TIPO_VIVIENDAPropiedad libre       1.608e+00  5.809e-01   2.769 0.005631 ** 
## TIPO_VIVIENDAVive con la familia   4.307e-01  3.078e-01   1.399 0.161711    
## VALOR_VIVIENDA                     3.627e-06  2.572e-06   1.410 0.158415    
## PATRIMONIO                                NA         NA      NA       NA    
## NACIONALIDADExtranjero            -1.615e+00  2.477e-01  -6.519 7.08e-11 ***
## IMPORTE                            2.289e-04  3.975e-05   5.759 8.48e-09 ***
## CUOTA                             -7.993e-03  1.706e-03  -4.685 2.80e-06 ***
## INGRESOS                           3.042e-06  1.591e-05   0.191 0.848375    
## SALDO                              4.666e-04  1.151e-04   4.052 5.08e-05 ***
## EDAD                              -5.231e-03  1.050e-02  -0.498 0.618370    
## ESTADO_CIVILSeparado              -1.434e+00  3.875e-01  -3.702 0.000214 ***
## ESTADO_CIVILSoltero               -1.046e+00  2.505e-01  -4.178 2.94e-05 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## (Dispersion parameter for binomial family taken to be 1)
## 
##     Null deviance: 1067.53  on 1645  degrees of freedom
## Residual deviance:  718.37  on 1632  degrees of freedom
## AIC: 746.37
## 
## Number of Fisher Scoring iterations: 7
library(broom)
## 
## Attaching package: 'broom'
## The following object is masked from 'package:DMwR':
## 
##     bootstrap
tidy(modelo)
## # A tibble: 15 × 5
##    term                                 estimate   std.error statistic   p.value
##    <chr>                                   <dbl>       <dbl>     <dbl>     <dbl>
##  1 (Intercept)                        2.24        0.612          3.67   2.47e- 4
##  2 TIPO_VIVIENDAOtros                 0.158       0.383          0.413  6.80e- 1
##  3 TIPO_VIVIENDAPropiedad hipotecada  0.699       0.386          1.81   7.00e- 2
##  4 TIPO_VIVIENDAPropiedad libre       1.61        0.581          2.77   5.63e- 3
##  5 TIPO_VIVIENDAVive con la familia   0.431       0.308          1.40   1.62e- 1
##  6 VALOR_VIVIENDA                     0.00000363  0.00000257     1.41   1.58e- 1
##  7 PATRIMONIO                        NA          NA             NA     NA       
##  8 NACIONALIDADExtranjero            -1.61        0.248         -6.52   7.08e-11
##  9 IMPORTE                            0.000229    0.0000397      5.76   8.48e- 9
## 10 CUOTA                             -0.00799     0.00171       -4.68   2.80e- 6
## 11 INGRESOS                           0.00000304  0.0000159      0.191  8.48e- 1
## 12 SALDO                              0.000467    0.000115       4.05   5.08e- 5
## 13 EDAD                              -0.00523     0.0105        -0.498  6.18e- 1
## 14 ESTADO_CIVILSeparado              -1.43        0.387         -3.70   2.14e- 4
## 15 ESTADO_CIVILSoltero               -1.05        0.250         -4.18   2.94e- 5

También podemos utilizar el software WEKA para la selección de variables. A continuación, se muestra una imagen con el resultado de haber aplicado un método Ranker.

Selección de variables Método Ranker con WeKA

Las dos formas de la selección de variables me dieron resultados diferentes. Basándome en ambos resultados, sólo voy a dejar fuera las variables EDAD,INGRESOS,PATRIMONIO. Estas variables se excluirán al obtener una muestra equilibrada utilizando el método del cubo.

Antes de realizar el método del cubo recordamos con una simple tabla los registros de nuestra variable de clasificación, CLASE.

t2 <- table(datos_imputados_knn$CLASE)
addmargins(t2)
## 
##   NO   SI  Sum 
##  164 1482 1646

Muestreo aleatorio

datos1482 <- subset(datos_imputados_knn, CLASE == "SI")
datos164 <- subset(datos_imputados_knn, CLASE == "NO")

#Tamaño de la muestra
n <-164
set.seed(0)
muestra <- sample(1:nrow(datos1482),size=n,replace=FALSE)
muestra164 <- datos1482[muestra, ]
datos_aleatorios_328 <- rbind(muestra164, datos164) #Muestra final 1

# Conjunto de datos equilibrado
summary(datos_aleatorios_328)
##               TIPO_VIVIENDA VALOR_VIVIENDA     PATRIMONIO     NACIONALIDAD
##  Alquiler            :81    Min.   :     0   Min.   :0    Español   :219  
##  Otros               :23    1st Qu.:     0   1st Qu.:0    Extranjero:109  
##  Propiedad hipotecada:91    Median :     0   Median :0                    
##  Propiedad libre     :59    Mean   : 62743   Mean   :0                    
##  Vive con la familia :74    3rd Qu.:120000   3rd Qu.:0                    
##                             Max.   :350000   Max.   :0                    
##     IMPORTE          CUOTA          INGRESOS         SALDO        
##  Min.   :  400   Min.   : 22.0   Min.   :    0   Min.   :-920.00  
##  1st Qu.: 3000   1st Qu.:104.0   1st Qu.:12406   1st Qu.:  17.75  
##  Median : 6000   Median :180.0   Median :15235   Median : 272.50  
##  Mean   : 7092   Mean   :186.5   Mean   :15962   Mean   :1031.19  
##  3rd Qu.: 9000   3rd Qu.:250.0   3rd Qu.:19539   3rd Qu.: 977.25  
##  Max.   :22400   Max.   :470.0   Max.   :35649   Max.   :9036.00  
##       EDAD         ESTADO_CIVIL CLASE   
##  Min.   :20.00   Casado  :137   NO:164  
##  1st Qu.:32.00   Separado: 20   SI:164  
##  Median :42.00   Soltero :171           
##  Mean   :41.51                          
##  3rd Qu.:49.25                          
##  Max.   :75.00
head(datos_aleatorios_328)
##          TIPO_VIVIENDA VALOR_VIVIENDA PATRIMONIO NACIONALIDAD IMPORTE CUOTA
## 1:     Propiedad libre         300000          0      Español   20500   193
## 2: Vive con la familia              0          0      Español   20000   399
## 3:     Propiedad libre         125000          0      Español    9000   250
## 4: Vive con la familia              0          0      Español    6000   146
## 5: Vive con la familia              0          0      Español    9000   250
## 6: Vive con la familia              0          0      Español   18000   365
##    INGRESOS SALDO EDAD ESTADO_CIVIL CLASE
## 1:    17263   102   48       Casado    SI
## 2:    13255  8821   22      Soltero    SI
## 3:    30791  2861   57       Casado    SI
## 4:     5745  -120   55      Soltero    SI
## 5:    19693  2960   35       Casado    SI
## 6:    13300   774   32      Soltero    SI

Muestreo con el método del cubo.

# Datos donde efectuamos la selección de las transacciones datos_SIs
datos_SI = datos_imputados_knn[ datos_imputados_knn$CLASE == "SI", ]


# Número de transacciones datos_SI
datos_SIs = nrow(datos_SI)


# Creamos las variables indicadores para cada una de las variables de equilibrio. 
# Variable que vale 1 en todas las partes (para comprobar la estimación del tamaño poblacional)
UNO = rep(1, datos_SIs) 


# Variables cuantitativas
X1 = datos_SI[ , c("VALOR_VIVIENDA", "IMPORTE", "SALDO", "CUOTA")]

# Variables cualitativas
X2 <- disjunctive(datos_SI$TIPO_VIVIENDA)
colnames(X2) <- levels(datos_SI$TIPO_VIVIENDA)
X3 <- disjunctive(datos_SI$NACIONALIDAD)
colnames(X3) <- levels(datos_SI$NACIONALIDAD)
X4 <- disjunctive(datos_SI$ESTADO_CIVIL)
colnames(X4) <- levels(datos_SI$ESTADO_CIVIL)

# Matriz de diseño
X = as.matrix(cbind(UNO, X1,X2,X3,X4))


# Tamaño de la muestra
s.datos = 164


# Probabilidades de inclusión
pik = rep(s.datos / datos_SIs, datos_SIs)


# extracción de la muestra
# method = 2 para una fase de aterrizaje por supresión de variables
# order =1 los datos se ordenan aleatoriamente

set.seed(012)
s = samplecube( X, pik, method = 2, order = 1, comment = FALSE )


# Generación de fichero resultante
muestra.datos_SI = cbind( datos_SI, s )
muestra.datos_SI = muestra.datos_SI[ muestra.datos_SI$s == 1, ]
muestra.datos_SI$s  = NULL

Debemos comprobar la calidad de nuestro muestreo, para lo cual recurrimos a los estimadores de Horvitz-Thompson y vemos, en la última columna, la desviación de cada media en porcentaje. En este caso, sólo dos niveles “otros” y “Separados” de diferentes variables han mostrado alguna desviación en sus valores medios. Sin embargo, para la mayoría de las variables no hay mucha desviación.

# Calidad de la muestra obtenida

Totales = apply(X, 2, sum)

Horvitz.Thompson =  apply(X * s / pik, 2, sum)

calidad =  cbind.data.frame(Totales, Horvitz.Thompson)

calidad$Desv.Abs. =  round(calidad$Totales - calidad$Horvitz.Thompson, 2)

calidad$Desv.Rel. =  round((calidad$Totales / calidad$Horvitz.Thompson - 1) *100, 2)

print(as.matrix.data.frame(calidad))
##                        Totales Horvitz.Thompson  Desv.Abs. Desv.Rel.
## UNO                       1482     1.482000e+03       0.00      0.00
## VALOR_VIVIENDA       140400040     1.409474e+08 -547395.39     -0.39
## IMPORTE               12039435     1.205381e+07  -14375.85     -0.12
## SALDO                  2282547     2.257294e+06   25253.16      1.12
## CUOTA                   279453     2.793931e+05      59.85      0.02
## Alquiler                   128     1.265122e+02       1.49      1.18
## Otros                       61     6.325610e+01      -2.26     -3.57
## Propiedad hipotecada       562     5.602683e+02       1.73      0.31
## Propiedad libre            457     4.608659e+02      -3.87     -0.84
## Vive con la familia        274     2.710976e+02       2.90      1.07
## Español                   1336     1.337415e+03      -1.41     -0.11
## Extranjero                 146     1.445854e+02       1.41      0.98
## Casado                     815     8.132927e+02       1.71      0.21
## Separado                    76     8.132927e+01      -5.33     -6.55
## Soltero                    591     5.873780e+02       3.62      0.62

No utilizo el método SMOTE porque no es necesario un sobremuestreo de la clase minoritaria, ya que dispongo de 164 observaciones para obtener un conjunto de muestras equilibradas de 328. Además, me parece más lógico conservar las observaciones originales que crear muestras sintéticas, ya que así se evitan los sesgos.

# Fichero final con las muestras balanceadas

# Conjunto de datos resultante

datos_mdc_328 = rbind(muestra.datos_SI, datos164)  #Muestra final 2

dim(datos_mdc_328)
## [1] 328  11
# Tabla de frecuencias de la variable dependiente para observar que los datos están ya balanceados

table(datos_mdc_328$CLASE)
## 
##  NO  SI 
## 164 164

Comparación de variables

Ahora vamos a comparar las dos muestras con los datos originales y comprobar si hay muchas diferencias en sus parametros.

Variable: IMPORTE

Considerando la variable numérica IMPORTE y analizando los resultados obtenidos, podemos observar que la media y la mediana de los datos originales sin imputación difiere de la de esas dos muestras obtenidas por métodos diferentes. Sin embargo, los resultados de las dos muestras son algo similares.

data1_var <- pull(datos_imputados_knn, "IMPORTE")
data2_var <- pull(datos_aleatorios_328, "IMPORTE")
data3_var <- pull(datos_mdc_328, "IMPORTE")

set.seed(0)
sumario <- tibble(
  Datos = c("Datos originales", "Datos equilibrados con selección aleatoria", "Datos equilibrados con muestra del método del cubo"),
  Media = c(mean(data1_var), mean(data2_var), mean(data3_var)),
  Mediana = c(median(data1_var), median(data2_var), median(data3_var))
)

sumario
## # A tibble: 3 × 3
##   Datos                                              Media Mediana
##   <chr>                                              <dbl>   <dbl>
## 1 Datos originales                                   7881.    9000
## 2 Datos equilibrados con selección aleatoria         7092.    6000
## 3 Datos equilibrados con muestra del método del cubo 6909.    6000
par(mfrow = c(1, 3))
mean1 <- mean(datos_imputados_knn$IMPORTE)
mean2 <- mean(datos_aleatorios_328$IMPORTE)
mean3 <- mean(datos_mdc_328$IMPORTE)

median1 <- median(datos_imputados_knn$IMPORTE)
median2 <- median(datos_aleatorios_328$IMPORTE)
median3 <- median(datos_mdc_328$IMPORTE)


ggplot(datos_imputados_knn, aes(x = IMPORTE)) +
  geom_histogram(binwidth = 500, color = "black", fill = "white") +
  geom_vline(aes(xintercept = mean1), color = "blue", linetype = "dashed", size = 1) +
  geom_vline(aes(xintercept = median1), color = "red", linetype = "dashed", size = 1) +
  labs(title = "Datos originales",
       x = "IMPORTE", y = "Frecuencia")+
  scale_x_continuous(limits = c(0, 30000))
## Warning: Using `size` aesthetic for lines was deprecated in ggplot2 3.4.0.
## ℹ Please use `linewidth` instead.
## Warning: Removed 2 rows containing missing values (`geom_bar()`).

ggplot(datos_aleatorios_328, aes(x = IMPORTE)) +
  geom_histogram(binwidth = 500, color = "black", fill = "white") +
  geom_vline(aes(xintercept = mean2), color = "blue", linetype = "dashed", size = 1) +
  geom_vline(aes(xintercept = median2), color = "red", linetype = "dashed", size = 1) +
  labs(title = "Datos equilibrados con selección aleatoria",
       x = "IMPORTE", y = "Frecuencia")

ggplot(datos_mdc_328, aes(x = IMPORTE)) +
  geom_histogram(binwidth = 500, color = "black", fill = "white") +
  geom_vline(aes(xintercept = mean3), color = "blue", linetype = "dashed", size = 1) +
  geom_vline(aes(xintercept = median3), color = "red", linetype = "dashed", size = 1) +
  labs(title = "Datos equilibrados con método de cubo",
       x = "IMPORTE", y = "Frecuencia")

Variable: TIPO_VIVIENDA

Considerando la variable categórica TIPO_VIVIENDA y observando los resultados obtenidos, podemos comparar la frecuencia y el porcentaje de niveles de la variable obtenidos en los tres casos. Podemos observar que mientras en la base de datos original los diferentes niveles estaban distribuidos de forma desigual, en el caso de las muestras equilibradas, en ambos casos los datos están distribuidos de forma más uniforme. Aunque ninguno de los métodos de muestreo puede considerarse mejor que otro, cada método tiene sus pros y sus contras.

par(mfrow = c(1, 3))
freq(datos_imputados_knn$TIPO_VIVIENDA)

##                    var frequency percentage cumulative_perc
## 1 Propiedad hipotecada       590      35.84           35.84
## 2      Propiedad libre       463      28.13           63.97
## 3  Vive con la familia       316      19.20           83.17
## 4             Alquiler       200      12.15           95.32
## 5                Otros        77       4.68          100.00
freq(datos_aleatorios_328$TIPO_VIVIENDA)

##                    var frequency percentage cumulative_perc
## 1 Propiedad hipotecada        91      27.74           27.74
## 2             Alquiler        81      24.70           52.44
## 3  Vive con la familia        74      22.56           75.00
## 4      Propiedad libre        59      17.99           92.99
## 5                Otros        23       7.01          100.00
freq(datos_mdc_328$TIPO_VIVIENDA)

##                    var frequency percentage cumulative_perc
## 1 Propiedad hipotecada        90      27.44           27.44
## 2             Alquiler        86      26.22           53.66
## 3  Vive con la familia        72      21.95           75.61
## 4      Propiedad libre        57      17.38           92.99
## 5                Otros        23       7.01          100.00